home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / irccol1a / chanwind.cls next >
Encoding:
Visual Basic class definition  |  1998-10-08  |  13.5 KB  |  392 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ChanWindow"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10.  
  11. Private Declare Function SetScrollRange Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, ByVal nMinPos As Long, ByVal nMaxPos As Long, ByVal bRedraw As Long) As Long
  12. Private Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
  13.  
  14.  
  15. Private Const SB_LINEDOWN = 1
  16.  
  17. Private Declare Function SetScrollPos Lib "user32" (ByVal hwnd As Long, ByVal nBar As Long, ByVal nPos As Long, ByVal bRedraw As Long) As Long
  18.  
  19.  
  20. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  21. Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
  22.  
  23.  
  24. Private Const MM_LOENGLISH = 4
  25.  
  26.  
  27.  
  28. Private Type POINTAPI
  29.         X As Long
  30.         Y As Long
  31. End Type
  32.  
  33. Private Type RECT
  34.         Left As Long
  35.         TOP As Long
  36.         Right As Long
  37.         Bottom As Long
  38. End Type
  39.  
  40. Public OwnerForm As Form
  41. Rem ------ Window Stuff
  42. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  43. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  44. Private Declare Function DeferWindowPos Lib "user32" (ByVal hWinPosInfo As Long, ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  45. Private Declare Function ScrollWindow Lib "user32" (ByVal hwnd As Long, ByVal XAmount As Long, ByVal YAmount As Long, lpRect As RECT, lpClipRect As RECT) As Long
  46. Private Declare Function LPtoDP Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
  47. Private Declare Function DPtoLP Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
  48. Private Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long
  49. Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57. Private Const SWP_NOZORDER = &H4
  58. Private Const SWP_NOACTIVATE = &H10
  59. Private Const SWP_SHOWWINDOW = &H40
  60. Private Const SWP_NOMOVE = &H2
  61. Rem ------ Window Stuff
  62.  
  63. Rem ---- Form Moveing Api Calls
  64. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal Wparam As Long, lParam As Any) As Long
  65. Private Declare Function ReleaseCapture Lib "user32" () As Long
  66. Private Const WM_NCLBUTTONDOWN = &HA1
  67. Private Const WM_NCLBUTTONDBLCLK = &HA3
  68. Private Const WM_SETHOTKEY = &H32
  69. Private Const HTCAPTION = 2
  70. Rem ---- Form Moveing Api Calls
  71.  
  72.  
  73. Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
  74. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  75. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  76. Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal wOptions As Long, lpRect As RECT, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
  77. Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
  78. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  79.  
  80. Private Const TA_CENTER = 6
  81. Private Const ETO_OPAQUE = 2
  82. Private Const ETO_GRAYED = 1
  83. Private Const ETO_CLIPPED = 4
  84.  
  85. Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
  86. Private Type Size
  87.         cx As Long
  88.         cy As Long
  89. End Type
  90.  
  91. Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
  92.  
  93. Private Declare Function DrawCaption Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long, pcRect As RECT, ByVal un As Long) As Long
  94. Private Declare Function GetTextExtentPoint Lib "gdi32" Alias "GetTextExtentPointA" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSize As Size) As Long
  95. Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
  96. Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  97. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  98. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  99. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  100. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  101. Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  102. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  103. Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  104. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  105. Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
  106.  
  107. Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
  108. Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  109.  
  110. Rem ------- Edge
  111. Private Declare Function ScrollDC Lib "user32" (ByVal hdc As Long, ByVal dx As Long, ByVal dy As Long, lprcScroll As RECT, lprcClip As RECT, ByVal hrgnUpdate As Long, lprcUpdate As RECT) As Long
  112.  
  113.  
  114. Private Const RDW_UPDATENOW = &H100
  115.  
  116. Private Const BDR_RAISEDOUTER = &H1
  117. Private Const BDR_SUNKENOUTER = &H2
  118. Private Const BDR_RAISEDINNER = &H4
  119. Private Const BDR_SUNKENINNER = &H8
  120.  
  121. Private Const BDR_OUTER = &H3
  122. Private Const BDR_INNER = &HC
  123. Private Const BDR_RAISED = &H5
  124. Private Const BDR_SUNKEN = &HA
  125.  
  126. Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
  127. Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
  128. Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
  129. Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
  130.  
  131. Private Const BF_LEFT = &H1
  132. Private Const BF_TOP = &H2
  133. Private Const BF_RIGHT = &H4
  134. Private Const BF_BOTTOM = &H8
  135.  
  136. Private Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
  137. Private Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
  138. Private Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
  139. Private Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
  140. Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  141.  
  142. Private Const BF_DIAGONAL = &H10
  143.  
  144. ' For diagonal lines, the BF_RECT flags specify the end point of
  145. ' the vector bounded by the rectangle parameter.
  146. Private Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
  147. Private Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
  148. Private Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
  149. Private Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)
  150.  
  151. Private Const BF_MIDDLE = &H800    ' Fill in the middle.
  152. Private Const BF_SOFT = &H1000     ' Use for softer buttons.
  153. Private Const BF_ADJUST = &H2000   ' Calculate the space left over.
  154. Private Const BF_FLAT = &H4000     ' For flat rather than 3-D borders.
  155. Private Const BF_MONO = &H8000     ' For monochrome borders.
  156. Rem --edge
  157. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Boolean
  158. Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
  159.  
  160.  
  161. Private Declare Function Chord Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long) As Long
  162. Private Declare Function RedrawWindow Lib "user32" (ByVal hwnd As Long, lprcUpdate As RECT, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
  163. Private Buffer(100000) As String
  164.  
  165.  
  166.  
  167. Sub Printf3(txt As String, ByVal Xpos As Long, ByVal Ypos As Long, hdc As Long, Color As Long, bkC As Long, Trns As Boolean)
  168. Dim R As RECT
  169. Dim Sz As Size
  170. SetTextColor hdc, Color
  171. SetBkColor hdc, bkC
  172. Linc = Ypos
  173. R.TOP = Xpos
  174. For X = 1 To Len(txt)
  175. GetTextExtentPoint hdc, Mid(txt, X, 1), 1, Sz
  176.  
  177. R.Left = Linc
  178. R.Right = Linc + Sz.cx
  179. R.Bottom = R.TOP + Sz.cy
  180. If Trns = False Then ExtTextOut hdc, R.Left, R.TOP, ETO_OPAQUE, R, Mid(txt, X, 1), 1, 0
  181. If Trns = True Then ExtTextOut hdc, R.Left, R.TOP, ETO_CLIPPED, R, Mid(txt, X, 1), 1, 0
  182. Linc = Linc + Sz.cx
  183. 'ExtTextOut hdc, r.Left, r.Top, ETO_CLIPPED, r, txt, 1, 0
  184. '(&rc, 90, 190, 250, 220);
  185. Next X
  186. End Sub
  187.  
  188.  
  189.  
  190.  
  191.  
  192. Function Get_Metric(txt As String) As Long
  193. Dim S As Size
  194. X = GetTextExtentPoint(OwnerForm.hdc, txt, 1, S)
  195. Get_Metric = S.cx
  196. End Function
  197.  
  198. Function get_Metheight(txt As String) As Long
  199. Dim S As Size
  200. X = GetTextExtentPoint(OwnerForm.hdc, txt, 1, S)
  201. get_Metheight = S.cy
  202.  
  203. End Function
  204. Sub ScrWindowup(frm As Form, Am As Long)
  205.  
  206.  
  207. 'BitBlt OwnerForm.hdc, frm.ScaleLeft, frm.ScaleHeight, frm.ScaleWidth, frm.ScaleHeight, frm.hdc, frm.ScaleTop, frm.ScaleLeft, 0
  208.  
  209.  
  210.  
  211. Dim Scrollrect As RECT
  212. Dim ClipREct As RECT
  213. Scrollrect.TOP = frm.ScaleTop
  214. Scrollrect.Bottom = frm.ScaleHeight
  215. Scrollrect.Left = frm.ScaleLeft
  216. Scrollrect.Right = frm.ScaleWidth
  217.  
  218. ScrollWindow frm.hwnd, 0, -Am, Scrollrect, Scrollrect
  219.  
  220.  
  221. End Sub
  222.  
  223. Sub ScrWindowdw(frm As Form)
  224. Dim Scrollrect As RECT
  225. Dim ClipREct As RECT
  226. Scrollrect.TOP = frm.ScaleTop
  227. Scrollrect.Bottom = frm.ScaleHeight
  228. Scrollrect.Left = Form1.ScaleLeft
  229. Scrollrect.Right = Form1.ScaleWidth
  230. ScrollWindow frm.hwnd, 0, 15, Scrollrect, Scrollrect
  231.  
  232.  
  233. End Sub
  234. Sub Refresh()
  235. 'OwnerForm.Cls
  236. 'Dim T As Long
  237. 'For T = 1 To BC
  238. 'Out Buffer(T)
  239. 'Next T
  240. End Sub
  241. Function Out(data As String) As Long
  242. BC = BC + 1: Buffer(BC) = data
  243.  
  244. Dim Xt As Long
  245.  
  246. Dim Linc As Long, Tinc As Long
  247.  
  248. Dim CCODE As Long
  249. Dim FCode As Long
  250. Dim Scount As Long
  251. Dim TMPD As String
  252.  
  253. CCODE = RGB(0, 0, 0)
  254. FCode = RGB(255, 255, 255)
  255. 'Tinc = Form1.ScaleHeight - OwnerForm.FontSize
  256. Linc = 1
  257.  
  258.  
  259.  
  260. For Xt = 1 To Len(data)  '/The Loop starts here!
  261. St:
  262.  
  263.  
  264. TMPD = Mid(data, Xt, 1)
  265.  
  266. 'und
  267. If TMPD = "" Then
  268. Debug.Print "Changing Underline"
  269. Xt = Xt + 1
  270. If OwnerForm.FontUnderline = True Then OwnerForm.FontUnderline = False: GoTo St
  271. If OwnerForm.FontUnderline = False Then OwnerForm.FontUnderline = True: GoTo St
  272. End If
  273.  
  274.  
  275. Rem ------------------ BOLD --------
  276. If TMPD = "" Then
  277. Debug.Print "Changing BOLD"
  278. Xt = Xt + 1
  279. If OwnerForm.FontBold = True Then OwnerForm.FontBold = False: GoTo St
  280. If OwnerForm.FontBold = False Then OwnerForm.FontBold = True: GoTo St
  281. End If
  282.  
  283. 'Debug.Print Chr(1)
  284. If TMPD = "" Then Xt = Xt + 1: Debug.Print "Reseting Colors": GoTo St
  285. If TMPD = "" Then Xt = Xt + 1: Debug.Print "Handling Reverse": GoTo St
  286.  
  287.  
  288. If TMPD = "" Then
  289. Xt = Xt + 1
  290.  
  291.  
  292.  
  293. Dim tmp As String
  294. tmp = Mid(data, Xt, 2)
  295.  
  296. If Isnum(tmp) = True Then Fg = tmp: GoTo Calc
  297.  
  298. If Isnum(Mid(tmp, 1, 1)) = True Then Fg = Mid(tmp, 1, 1): GoTo Calc
  299. Fg = "": GoTo St
  300.  
  301. Calc:
  302. Xt = Xt + Len(Fg)
  303.  
  304.  
  305.  
  306.  
  307.  
  308. If Mid(data, Xt, 1) = "," Then
  309. Dim tmp2 As String
  310. Xt = Xt + 1
  311. tmp2 = Trim(Mid(data, Xt, 2))
  312.  
  313. If Isnum(tmp2) = False Then tmp2 = Mid(tmp2, 1, 1)
  314.  
  315.  
  316. Xt = Xt + Len(tmp2)
  317. GoTo St
  318.  
  319. Else
  320. GoTo St
  321. End If
  322.  
  323.  
  324. End If
  325.  
  326.  
  327.  
  328. Dt:
  329.  
  330. Scount = Scount + 1
  331. If tmp <> "" Then FCode = ret_Color(Val(tmp))
  332. If tmp2 <> "" Then CCODE = ret_Color(Val(tmp2))
  333.  
  334.  
  335. STRIP = STRIP + TMPD
  336.  
  337. Rem --- Virtual Sizer
  338. Tmetric = Me.Get_Metric(TMPD)
  339.  
  340. If Linc + Tmetric * 2 > OwnerForm.ScaleWidth Then Linc = 0: Me.ScrWindowup OwnerForm, 15
  341.  
  342. Printf3 TMPD, OwnerForm.ScaleHeight - 35, Linc, OwnerForm.hdc, FCode, CCODE, True
  343. Linc = Linc + Tmetric:
  344.  
  345.  
  346.  
  347. Next Xt
  348.  
  349.  
  350. End Function
  351.  
  352. Function Isnum(S As String) As Boolean
  353. Dim X As Long
  354. For X = 0 To 15
  355. If CStr(X) = S Then Isnum = True: Exit Function
  356. Next X
  357. Isnum = False
  358. End Function
  359.  
  360.  
  361.  
  362.  
  363.  
  364. Function ret_Color(CCODE As Long) As Long
  365. If CCODE = 0 Then ret_Color = RGB(255, 255, 255)
  366. If CCODE = 1 Then ret_Color = 0:
  367. If CCODE = 2 Then ret_Color = RGB(0, 0, 155)
  368. If CCODE = 3 Then ret_Color = RGB(0, 150, 0)
  369. If CCODE = 4 Then ret_Color = RGB(200, 0, 0)
  370. If CCODE = 5 Then ret_Color = RGB(127, 0, 0)
  371. If CCODE = 6 Then ret_Color = RGB(156, 0, 156)
  372. If CCODE = 7 Then ret_Color = RGB(252, 127, 0)
  373. If CCODE = 8 Then ret_Color = QBColor(14)
  374. If CCODE = 9 Then ret_Color = RGB(0, 255, 0)
  375. If CCODE = 10 Then ret_Color = RGB(0, 147, 147)
  376. If CCODE = 11 Then ret_Color = RGB(0, 255, 255)
  377. If CCODE = 12 Then ret_Color = RGB(0, 0, 255)
  378. If CCODE = 13 Then ret_Color = RGB(255, 0, 255)
  379. If CCODE = 14 Then ret_Color = RGB(155, 155, 155)
  380. If CCODE = 15 Then ret_Color = RGB(255, 255, 255)
  381.  
  382.  
  383. End Function
  384.  
  385. Private Sub Class_Initialize()
  386. 'SetScrollRange OwnerForm.hwnd, 1, 1, 500, 1
  387. 'ShowScrollBar OwnerForm.hwnd, 1, 1
  388. 'SetScrollPos OwnerForm.hwnd, 1, 1, 1
  389. End Sub
  390.  
  391.  
  392.